home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 7_2009-2012.ISO / data / zips / Function_D2181165152010.psc / Function Drawer / Class Modules / DrawText.cls < prev    next >
Text File  |  2010-04-25  |  10KB  |  322 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "DrawText"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. Private Const LOGPIXELSY = 90        '  Logical pixels/inch in Y
  17.  
  18. Private Const TRANSPARENT = 1
  19. Private Const OPAQUE = 2
  20.  
  21. Private Const DT_TOP = &H0
  22. Private Const DT_LEFT = &H0
  23. Private Const DT_CENTER = &H1
  24. Private Const DT_RIGHT = &H2
  25. Private Const DT_VCENTER = &H4
  26. Private Const DT_BOTTOM = &H8
  27. Private Const DT_WORDBREAK = &H10
  28. Private Const DT_SINGLELINE = &H20
  29. Private Const DT_EXPANDTABS = &H40
  30. Private Const DT_TABSTOP = &H80
  31. Private Const DT_NOCLIP = &H100
  32. Private Const DT_EXTERNALLEADING = &H200
  33. Private Const DT_CALCRECT = &H400
  34. Private Const DT_NOPREFIX = &H800
  35. Private Const DT_HIDEPREFIX = &H100000
  36. Private Const DT_PREFIXONLY = &H200000
  37. Private Const DT_INTERNAL = &H1000
  38. Private Const DT_EDITCONTROL = &H2000
  39. Private Const DT_PATH_ELLIPSIS = &H4000
  40. Private Const DT_END_ELLIPSIS = &H8000
  41. Private Const DT_MODIFYSTRING = &H10000
  42. Private Const DT_RTLREADING = &H20000
  43. Private Const DT_WORD_ELLIPSIS = &H40000
  44.  
  45. Private Const NONANTIALIASED_QUALITIY = 3
  46. Private Const ANTIALIASED_QUALITIY = 5
  47. Private Const CLEARTYPE_QUALITIY = 6
  48.  
  49. Private Type RECT
  50.         Left As Long
  51.         Top As Long
  52.         Right As Long
  53.         Bottom As Long
  54. End Type
  55.  
  56. Private Type DRAWTEXTPARAMS
  57.     cbSize As Long
  58.     iTabLength As Long
  59.     iLeftMargin As Long
  60.     iRightMargin As Long
  61.     uiLengthDrawn As Long
  62. End Type
  63.  
  64. Public Enum TextVerticalAlign
  65.     AlignTop = DT_TOP
  66.     AlignVCenter = DT_VCENTER
  67.     AlignBottom = DT_BOTTOM
  68. End Enum
  69.  
  70. Public Enum TextEllipsis
  71.     NoEllipsis = 0
  72.     EndEllipsis = DT_END_ELLIPSIS
  73.     PathEllpsis = DT_PATH_ELLIPSIS
  74.     WordEllipsis = DT_WORD_ELLIPSIS
  75. End Enum
  76.  
  77. Public Enum PrefixMode
  78.     ShowPrefix = 0
  79.     HidePrefix = DT_HIDEPREFIX
  80.     NoPrefix = DT_NOPREFIX
  81.     PrefixOnly = DT_PREFIXONLY
  82. End Enum
  83.  
  84. Public Enum SmoothingModes
  85.     SmoothingModeNonAntiAliased = NONANTIALIASED_QUALITIY
  86.     SmoothingModeAntiAliased = ANTIALIASED_QUALITIY
  87.     SmoothingModeClearType = CLEARTYPE_QUALITIY
  88. End Enum
  89.  
  90. Private Declare Function GetTextColor Lib "gdi32" (ByVal hdc As Long) As Long
  91. Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  92. Private Declare Function GetBkMode Lib "gdi32" (ByVal hdc As Long) As Long
  93. Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
  94.  
  95. Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal lfHeight As Long, ByVal lfWidth As Long, ByVal lfEscapement As Long, ByVal lfOrientation As Long, ByVal lfWeight As Long, ByVal lfItalic As Long, ByVal lfUnderline As Long, ByVal lfStrikeOut As Long, ByVal lfCharSet As Long, ByVal lfOutPrecision As Long, ByVal lfClipPrecision As Long, ByVal lfQuality As Long, ByVal lfPitchAndFamily As Long, ByVal lfFaceName As String) As Long
  96. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  97. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  98.  
  99. Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
  100. Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
  101.  
  102. Private Declare Function DrawTextExA Lib "user32" (ByVal hdc As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, lpDrawTextParams As DRAWTEXTPARAMS) As Long
  103. Private Declare Function DrawTextExW Lib "user32" (ByVal hdc As Long, ByVal lpsz As Long, ByVal n As Long, lpRect As RECT, ByVal un As Long, lpDrawTextParams As DRAWTEXTPARAMS) As Long
  104.  
  105. Dim dthDC As Long
  106. Dim dtSmoothingMode As SmoothingModes
  107. Dim dtMeasureInPexils As Boolean
  108. Dim dtAlign As AlignmentConstants
  109. Dim dtVerticalAlign As TextVerticalAlign
  110. Dim dtEllipsis As TextEllipsis
  111. Dim dtPrefix As PrefixMode
  112. Dim dtWordWrap As Boolean
  113. Dim dtTabStop As Boolean
  114. Dim dtSingleLine As Boolean
  115. Dim dtUseTabWidth As Boolean
  116. Dim dtNoClip As Boolean
  117. Dim dtMultiLine As Boolean
  118. Dim dtRightToLeft As Boolean
  119. Dim dtTabWidth As Long
  120. Dim dtLeftMargin As Long
  121. Dim dtRightMargin As Long
  122.  
  123. Friend Property Get hdc() As Long
  124.     hdc = dthDC
  125. End Property
  126.  
  127. Friend Property Let hdc(ByVal vNewValue As Long)
  128.    dthDC = vNewValue
  129. End Property
  130.  
  131. Friend Property Get SmoothingMode() As SmoothingModes
  132.     SmoothingMode = dtSmoothingMode
  133. End Property
  134.  
  135. Friend Property Let SmoothingMode(ByVal vNewValue As SmoothingModes)
  136.     dtSmoothingMode = vNewValue
  137. End Property
  138.  
  139. Friend Property Get MeasureInPixels() As Boolean
  140.     MeasureInPexils = dtMeasureInPexils
  141. End Property
  142.  
  143. Friend Property Let MeasureInPexils(ByVal vNewValue As Boolean)
  144.    dtMeasureInPexils = vNewValue
  145. End Property
  146.  
  147. Friend Property Get Align() As AlignmentConstants
  148.     Align = dtAlign
  149. End Property
  150.  
  151. Friend Property Let Align(ByVal vNewValue As AlignmentConstants)
  152.    dtAlign = vNewValue
  153. End Property
  154.  
  155. Friend Property Get VerticalAlign() As TextVerticalAlign
  156.     VerticalAlign = dtVerticalAlign
  157. End Property
  158.  
  159. Friend Property Let VerticalAlign(ByVal vNewValue As TextVerticalAlign)
  160.    dtVerticalAlign = vNewValue
  161. End Property
  162.  
  163. Friend Property Get Ellipsis() As TextEllipsis
  164.     Ellipsis = dtEllipsis
  165. End Property
  166.  
  167. Friend Property Let Ellipsis(ByVal vNewValue As TextEllipsis)
  168.    dtEllipsis = vNewValue
  169. End Property
  170.  
  171. Friend Property Get Prefix() As PrefixMode
  172.     Prefix = dtPrefix
  173. End Property
  174.  
  175. Friend Property Let Prefix(ByVal vNewValue As PrefixMode)
  176.    dtPrefix = vNewValue
  177. End Property
  178.  
  179. Friend Property Get WordWrap() As Boolean
  180.     WordWrap = dtWordWrap
  181. End Property
  182.  
  183. Friend Property Let WordWrap(ByVal vNewValue As Boolean)
  184.    dtWordWrap = vNewValue
  185. End Property
  186.  
  187. Friend Property Get TabStop() As Boolean
  188.     TabStop = dtTabStop
  189. End Property
  190.  
  191. Friend Property Let TabStop(ByVal vNewValue As Boolean)
  192.    dtTabStop = vNewValue
  193. End Property
  194.  
  195. Friend Property Get SingleLine() As Boolean
  196.     SingleLine = dtSingleLine
  197. End Property
  198.  
  199. Friend Property Let SingleLine(ByVal vNewValue As Boolean)
  200.    dtSingleLine = vNewValue
  201. End Property
  202.  
  203. Friend Property Get UseTabWidth() As Boolean
  204.     UseTabWidth = dtUseTabWidth
  205. End Property
  206.  
  207. Friend Property Let UseTabWidth(ByVal vNewValue As Boolean)
  208.    dtUseTabWidth = vNewValue
  209. End Property
  210.  
  211. Friend Property Get NoClip() As Boolean
  212.     NoClip = dtNoClip
  213. End Property
  214.  
  215. Friend Property Let NoClip(ByVal vNewValue As Boolean)
  216.    dtNoClip = vNewValue
  217. End Property
  218.  
  219. Friend Property Get MultiLine() As Boolean
  220.     MultiLine = dtMultiLine
  221. End Property
  222.  
  223. Friend Property Let MultiLine(ByVal vNewValue As Boolean)
  224.    dtMultiLine = vNewValue
  225. End Property
  226.  
  227. Friend Property Get RightToLeft() As Boolean
  228.     RightToLeft = dtRightToLeft
  229. End Property
  230.  
  231. Friend Property Let RightToLeft(ByVal vNewValue As Boolean)
  232.    dtRightToLeft = vNewValue
  233. End Property
  234.  
  235. Friend Property Get TabWidth() As Long
  236.     TabWidth = dtTabWidth
  237. End Property
  238.  
  239. Friend Property Let TabWidth(ByVal vNewValue As Long)
  240.    dtTabWidth = vNewValue
  241. End Property
  242.  
  243. Friend Property Get LeftMargin() As Long
  244.     LeftMargin = dtLeftMargin
  245. End Property
  246.  
  247. Friend Property Let LeftMargin(ByVal vNewValue As Long)
  248.    dtLeftMargin = vNewValue
  249. End Property
  250.  
  251. Friend Property Get RightMargin() As Long
  252.     RightMargin = dtRightMargin
  253. End Property
  254.  
  255. Friend Property Let RightMargin(ByVal vNewValue As Long)
  256.    dtRightMargin = vNewValue
  257. End Property
  258.  
  259. Public Function Draw(ByVal str As String, ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long, ByVal Font As StdFont, ByVal FontColor As Long, ByVal FontAngle As Single, ByVal FontTransparent As Boolean, ByVal IsUnicode As Boolean)
  260.     Dim dtp As DRAWTEXTPARAMS
  261.     Dim SaveTextColor As Long, SaveBkMode As Long
  262.     Dim r As RECT
  263.     Dim hFont As Long, OldFont As Long
  264.     Dim dtFontSize As Long
  265.     Dim dtFlags As Long
  266.     
  267.     If dtMeasureInPexils Then
  268.         dtFontSize = Font.Size
  269.     Else
  270.         dtFontSize = -MulDiv(Font.Size, GetDeviceCaps(hdc, LOGPIXELSY), 72)
  271.     End If
  272.     
  273.     SaveTextColor = GetTextColor(dthDC)
  274.     SaveBkMode = GetBkMode(dthDC)
  275.     
  276.     SetTextColor dthDC, FontColor
  277.     SetBkMode dthDC, Abs(Not (FontTransparent)) + 1
  278.     
  279.     r.Left = X
  280.     r.Top = Y
  281.     r.Right = Width
  282.     r.Bottom = Height
  283.     
  284.     dtp.cbSize = Len(dtp)
  285.     dtp.iLeftMargin = dtLeftMargin
  286.     dtp.iRightMargin = dtRightMargin
  287.     dtp.iTabLength = dtTabWidth
  288.     
  289.     If dtAlign = vbLeftJustify Then
  290.         dtAlign = DT_LEFT
  291.     ElseIf dtAlign = vbRightJustify Then
  292.         dtAlign = DT_RIGHT
  293.     ElseIf dtAlign = vbCenter Then
  294.         dtAlign = DT_CENTER
  295.     End If
  296.     dtFlags = dtAlign Or dtVerticalAlign Or dtEllipsis Or dtPrefix Or _
  297.               Abs(dtWordWrap * DT_WORDBREAK) Or _
  298.               Abs(dtSingleLine * DT_SINGLELINE) Or _
  299.               Abs(dtUseTabWidth * DT_EXPANDTABS) Or _
  300.               Abs(dtNoClip * DT_WORDBREAK) Or _
  301.               Abs(dtMultiLine * DT_WORDBREAK) Or _
  302.               Abs(dtTabStop * DT_TABSTOP) Or _
  303.               Abs(dtMultiLine * DT_EDITCONTROL) Or _
  304.               Abs(dtRightToLeft * DT_WORDBREAK)
  305.               
  306.     hFont = CreateFont(dtFontSize, 0, FontAngle, 0, Font.Weight, Font.Italic, Font.Underline, Font.Strikethrough, Font.Charset, 0, 0, dtSmoothingMode, 0, Font.Name)
  307.     OldFont = SelectObject(dthDC, hFont)
  308.     
  309.     If IsUnicode Then
  310.         DrawTextExW dthDC, StrPtr(str), Len(str), r, dtFlags, dtp
  311.     Else
  312.         DrawTextExA dthDC, str, Len(str), r, dtFlags, dtp
  313.     End If
  314.     
  315.     SelectObject dthDC, OldFont
  316.     DeleteObject hFont
  317.     
  318.     SetBkMode dthDC, SaveBkMode
  319.     SetTextColor dthDC, SaveTextColor
  320.  
  321. End Function
  322.